package Net::Nirvanix;

use warnings;
use strict;
use vars qw($VERSION);

use Data::Dumper;


use Fcntl;
use threads;
use threads::shared;
use Carp;
use Digest::MD5;
use MIME::Base64;
use File::Basename;
use Encode;
use URI::Escape;
use HTTP::Request::Common qw(POST);
use HTTP::Request::Common qw(GET);
use HTTP::Request::Common qw(HEAD);
use LWP::UserAgent;
use XML::Simple;

=instructions

Need to install from cpan:

XML::Simple
HTML::Parser

Need multi-threaded build of perl.

if uploading files > 20gb compile perl with: -Duselargefiles

Threading and SSL can cause a segmentation fault on some systems.  If you are
affected by this you should not use SSL or set the thread count to 1 on uploads / 
downloads to avoid this problem.

=cut

$VERSION = "1.00";

# Defaults
my %Default = (
    raise_error => 0,           # Mimic DBI module's error handling
    print_error => 1,           # Mimic DBI module's error handling
    retry_attempts => 10,        # Maximum number of retry attempts
    retry_interval => 10,        # Delay between retry attempts in seconds
    debug => 0,                 # Debug level (0-4)
    dynamic_file_upload => 1,   # Whether to avoid loading files into memory
    session_max_inactivity => 15 * 60, # Max inactivity before obtaining a new token
);

my $download_thread_count : shared = 0;
my @download_chunk_stack : shared;
my $download_error : shared = 0;

my $upload_thread_count : shared = 0;
my @upload_chunk_stack : shared;
my $upload_error : shared = 0;

# Constants
my $Host = "http://services.nirvanix.com";
my $Host_secure = "https://services.nirvanix.com";


# Constructor
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    $self->{namespace} = $_[0];
    bless ($self, $class);
    
    $self->_initialize;
    
    return $self;
}

sub _initialize {
    my $self = shift;

    # Instantiate LWP user agent
    $self->{lwp}{ua} = LWP::UserAgent->new;

    # Instantiate XML parser
    $self->{xml_parser} = XML::Simple->new(
        ContentKey      => "-content",
        ForceArray      => [ "Data", "File", "Folder" ],
        GroupTags       => { "Metadata" => "Data" },
        KeyAttr         => { "Data" => "Key" },
        SuppressEmpty   => undef,
    );

    return;
}

sub _cleanup {
    my $self = shift;
    return;
}

sub DESTROY {
    my $self = shift;

	#TODO: Kill all threads if they are not already gone.
	
    $self->_cleanup() if($self->{'AutoSave'});
    return;
}

sub _error {
    my ($self, @messages) = @_;

    push @messages, "Error code: " . $self->error_code if $self->error_code;
    push @messages, "Error message: " . $self->error_msg if $self->error_msg;
    push @messages, "Error occurred" unless @messages;
	print @messages;
    if ($self->{raise_error}) {
        if ($self->{debug} >= 3) {
            confess join("\n", @messages);
        }
        else {
            croak join("\n", @messages);
        }
    }
    else {
        warn join("\n", @messages) if $self->print_error;
    }
    
    return undef;
}

sub upload {
	my ($self, %args) = @_;
	my $retries = 0;
	
	$args{threads} = 1 unless defined($args{threads});

	my $filesize = -s $args{localfile};
	my $chunk_size = 1024*1024*1;
	my $byte_range = 0;

	print "Calculating MD5.\n";
	my $calc_md5 = get_md5($args{localfile});
	
	while ($byte_range < $filesize) {
		if ($byte_range + $chunk_size > $filesize) {
			print "$byte_range,$filesize\n";
			push(@upload_chunk_stack, "$byte_range,$filesize");
		} else {
			my $end_range = $byte_range + $chunk_size;
			push(@upload_chunk_stack, "$byte_range,$end_range");
		}
		$byte_range += $chunk_size;
	}
	# Flip the stack so it downloads the first bytes first.
	@upload_chunk_stack = reverse(@upload_chunk_stack);
	#my $url = GETURL?
	while ((scalar(@upload_chunk_stack) > 0) || ($upload_thread_count != 0)) {
		if ($upload_error) {
			# This will try the head download and handle retry logic.
			# It will block any new threads from attempting the upload
			# while it determines if there is an error.  if it fails it
			# will raise an error and exit.
			
			# TODO: Add support for auto-reroute based on node outage.
			
			$self->get_head(url => $args{url});
			# all is fine, continue.
			$upload_error = 0;
		}
		# Leave the last chunk so it can be sent with the MD5 after the other threads are complete.
		if (($upload_thread_count < $args{threads}) && (scalar(@upload_chunk_stack) > 0)) {
			my @data;
			{
				lock($upload_thread_count);
				$upload_thread_count++;
				lock(@upload_chunk_stack);
				@data = split(',', pop(@upload_chunk_stack));
			}
			if ($args{threads} != 1) {
				threads->new(\&upload_thread, localfile=>$args{localfile}, 
					url => $args{url}, start_byte => $data[0], end_byte => $data[1] )->detach;
			} else {
				upload_thread(localfile=>$args{localfile}, 
					url => $args{url}, start_byte => $data[0], end_byte => $data[1]);
			}
		}
	}
	while ($upload_error == 0) {
		if ($upload_error) {
			# This will try the head download and handle retry logic.
			# It will block any new threads from attempting the upload
			# while it determines if there is an error.  if it fails it
			# will raise an error and exit.
			
			# TODO: Add support for auto-reroute based on node outage.
			
			$self->get_head(url => $args{url});
			# all is fine, continue.
			$upload_error = 0;
		}
		# after all threads are complete send the last chunk with the MD5
		upload_thread(localfile=>$args{localfile}, 
			url => $args{url}, 0, 0,
			md5 => $calc_md5 );
		if ($upload_error == 0) {
			last;
		}
	}
}

sub upload_thread {
	my (%args) = @_;
	my $data = "";
	my $filesize = 0;
	if (!$args{md5}) {
		$filesize = -s $args{localfile};
		my $size = $args{end_byte} - $args{start_byte};
		open (FH,$args{localfile});
		seek(FH, $args{start_byte}, 0);
		read(FH, $data, $size);
		close(FH);
	}
	
    my $ua = LWP::UserAgent->new;
	$ua->timeout(10);
	my $url = $args{url};
	my $boundary = "123123123123";
	my $footer = "\r\n--$boundary--\r\n";
	my $header = "--$boundary\r\n";
	$header .= "Content-Disposition: form-data; name=\"filecontent\"; filename=\"$args{localfile}\";\r\n";
	$header .= "Content-Type: binary/octet-stream\r\n";
	
	if ($args{md5}) {
		$url .= "&fileMD5=" . $args{md5};
		$header .= "\r\n";
	} else {
		my $end = $args{end_byte} - 1;
		$header .= "Content-Range: $args{start_byte}-$end/$filesize\r\n\r\n";
	}

	print $header;
	$data = $header . $data . $footer;
	
	$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 0;
	my $response = $ua->post($url, 
		Content_Type => "multipart/form-data; boundary=$boundary", 
		Content => $data);
    if ($response->is_success()) {
		# Read xml to be sure no error happened.
	    # Instantiate XML parser
	    my $xml_parser = XML::Simple->new(
	        ContentKey      => "-content",
	        ForceArray      => [ "Data", "File", "Folder" ],
	        GroupTags       => { "Metadata" => "Data" },
	        KeyAttr         => { "Data" => "Key" },
	        SuppressEmpty   => undef,
	    );
	    my $xml = $xml_parser->parse_string($response->content);
		print Dumper($xml);
	    my $error_code = $xml->{ResponseCode};
	    my $error_msg = $xml->{ErrorMessage};

	    if ($error_code != 0) {
			print STDERR "Error in thread $error_code - $error_msg.\n";
			lock($upload_error);
			$upload_error = 1;
			#push the data back up to be uploaded again.
			lock(@upload_chunk_stack);
			push(@upload_chunk_stack, "$args{start_byte},$args{end_byte}");
	    }

	} else {
		print STDERR "Error in thread " . $response->status_line . ".\n";
		lock($upload_error);
		$upload_error = 1;
		#push the data back up to be uploaded again.
		lock(@upload_chunk_stack);
		push(@upload_chunk_stack, "$args{start_byte},$args{end_byte}");
	}

	lock($upload_thread_count);
	$upload_thread_count--;
	return;

}

# Retrieve the head of the file and parse out the MD5 and file length.
sub get_head {
	my ($self, %args) = @_;
	my $retries = 0;
	while (1) {
		$self->{lwp}{request} = HEAD $args{url};
	    $self->{lwp}{response} = $self->{lwp}{ua}->request($self->{lwp}{request});
	    if ($self->{lwp}{response}->is_success()) {
			$self->{head}{content_length} = $self->{lwp}{response}->header("Content-Length");
			$self->{head}{md5} = $self->{lwp}{response}->header("Content-MD5");
			return;
		} else {
			$retries += 1;
            print STDERR "Retry $Default{retry_attempts} Retries $retries.\n" if $self->debug >= 4;
			if ($retries > $Default{retry_attempts}) {
				return $self->_error("Maximum retry attempts reached for download '$args{url}'.\n")
			}
            my $delay = $retries * $Default{retry_interval};
            print STDERR "Pausing $delay seconds.\n" if $self->debug >= 4;
            sleep $delay;
		}
	}
}

sub download {
	my ($self, %args) = @_;

	# setup the workerpool for download threads.
	$args{threads} = 1 unless defined($args{threads});
	
	$self->get_head(url => $args{url});
	if ($self->{head}{content_length} == 0) {
		# empty file, create file and exit.
		sysopen(FH,$args{localfile},O_WRONLY|O_CREAT);
		close(FH);
		return;
	}
	# 1mb
	my $chunk_size = 1024*1024*1;
	my $byte_range = 0;

	# TODO: reverse loop so file downloads early data first.
	while ($byte_range < $self->{head}{content_length}) {
		if ($byte_range + $chunk_size > $self->{head}{content_length}) {
			print "$byte_range,$self->{head}{content_length}\n";
			push(@download_chunk_stack, "$byte_range,$self->{head}{content_length}");
		} else {
			my $end_range = $byte_range + $chunk_size;
			print "$byte_range,$end_range\n";
			push(@download_chunk_stack, "$byte_range,$end_range");
		}
		$byte_range += $chunk_size;
	}
	# Flip the stack so it downloads the first bytes first.
	# TODO: Flip while loop so this isn't needed.
	@download_chunk_stack = reverse(@download_chunk_stack);
	# remove the file before download if it exists.
	unlink($args{localfile}) if (-e $args{localfile});

	while ((scalar(@download_chunk_stack) > 0) || ($download_thread_count != 0)) {
		if ($download_error) {
			# This will try the head download and handle retry logic.
			# It will block any new threads from attempting the download
			# while it determines if there is an error.  if it fails it
			# will raise an error and exit.
			
			# TODO: Add support for auto-reroute based on node outage.
			
			$self->get_head(url => $args{url});
			# all is fine, continue.
			$download_error = 0;
		}
		if (($download_thread_count < $args{threads}) && (scalar(@download_chunk_stack) > 0)) {
			my @data;
			{
				lock($download_thread_count);
				$download_thread_count++;
				lock(@download_chunk_stack);
				@data = split(',', pop(@download_chunk_stack));
			}
			threads->new(\&download_thread, localfile=>$args{localfile}, 
				url => $args{url}, start_byte => $data[0], end_byte => $data[1] )->detach;
		}
  	}

	my $calc_md5 = get_md5($args{localfile});
	if ($calc_md5 ne $self->{head}{md5}) {
		return $self->_error("MD5 Checksum failed, expected: '$self->{head}{md5}' calculated: '$calc_md5'");
	}
}

sub download_thread {
	my (%args) = @_;
    my $ua = LWP::UserAgent->new;
	$ua->timeout(10);
	print "\n$args{url}\nBytes: $args{start_byte} - $args{end_byte}\n";
	my $response = $ua->get($args{url}, Range=>"bytes=$args{start_byte}-$args{end_byte}");
    if ($response->is_success()) {
		# success, write $data to file at pos.
		print "\nWriting: $args{start_byte} \n";
		sysopen(FH,$args{localfile},O_WRONLY|O_CREAT);
		seek(FH, $args{start_byte}, 0);
		print FH $response->content;
		close(FH);
	} else {
		print STDERR "Error in thread " . $response->status_line . ".\n";
		lock($download_error);
		$download_error = 1;
		#push the data back up to be downloaded again.
		lock(@download_chunk_stack);
		push(@download_chunk_stack, "$args{start_byte},$args{end_byte}");
	}
	
	lock($download_thread_count);
	$download_thread_count--;
	return;
}

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

sub get_md5 {
    my $file = shift;
    open(FILE, $file) or die "Can't open '$file': $!";
    binmode(FILE);
    return trim(encode_base64(Digest::MD5->new->addfile(*FILE)->digest));
}

# This function handles all calls to services.nirvanix.com to call a function you
# define an array of params such as:
# my @params = (["appkey", "YOURAPPKEY"], ["username", "YOURUSERNAME"], ["password", "YOURPASSWORD"]);
# To call the API with these parameters pass in:
# Net::Nirvanix.Login(1, @params)
# the first parameter is if https should be used and the second is the array of params.
sub AUTOLOAD {
    my ($self, $secure, @params) = @_;
	my $caller = (caller(3))[3];
	
	my $function = our $AUTOLOAD;
	$function =~ s/.*:://;

	my $url = "";
	if ($secure) {
		$url = "$Host_secure";
	} else {
		$url = "$Host";
	}

	$url .= "/ws/" . $self->{namespace} . "/$function.ashx?";
	foreach my $param (@params) {
		$url .= uri_escape(@$param[0]) . "=" . uri_escape(@$param[1]) . "&";
	}

	$self->{lwp}{request} = GET $url;

    print $self->{lwp}{request}->as_string;

    $self->{lwp}{response} = $self->{lwp}{ua}->request($self->{lwp}{request});

    return $self->_error("Connection to '$url' failed: " . $self->{lwp}{response}->status_line)
        unless $self->{lwp}{response}->is_success;

    print $self->{lwp}{response}->content;

    $self->{response} = $self->{xml_parser}->parse_string(
        $self->{lwp}{response}->content);

    $self->{error_code} = $self->_response("ResponseCode");
    $self->{error_msg} = $self->_response("ErrorMessage");

    if ($self->{error_code} != 0) {
        return $self->_error();
    }
	
	return $self->{response};
}

# Get Nirvanix XML returned as a parsed hash ref
sub _response {
    my ($self, $key) = @_;
    return exists $self->{response}{$key} ? $self->{response}{$key} : undef;
}

############################# Advanced methods ##############################

# Get/set timeout of LWP::UserAgent in seconds
sub timeout {
    my $self = shift;
    $self->{lwp}{ua}->timeout(shift) if @_;
    return $self->{lwp}{ua}->timeout;
}

# Return internal LWP::UserAgent object (for debugging)
sub get_lwp_useragent {
    my $self = shift;
    return $self->{lwp}{ua};
}

# Return internal HTTP::Request object (for debugging)
sub get_http_request {
    my $self = shift;
    return $self->{lwp}{request};
}

# Return internal HTTP::Response object (for debugging)
sub get_http_response {
    my $self = shift;
    return $self->{lwp}{response};
}

# Get/set whether to use dynamic file uploads to avoid loading files
# into memory.  This is required to handle arbitrarily large files.
sub dynamic_file_upload {
    my $self = shift;
    $self->{dynamic_file_upload} = shift if @_;
    return $self->{dynamic_file_upload};
}

# Get/set debug level (0-4)
sub debug {
    my $self = shift;
    $self->{debug} = shift if @_;
    return $self->{debug};
}

############################# Error handling ################################

# Get Nirvanix response code from last transaction
sub error_code {
    my $self = shift;
    return $self->{error_code};
}

# Get last error message
sub error_msg {
    my $self = shift;
    return $self->{error_msg};
}

# Get/set whether an error raises an exception instead of returning an error
sub raise_error {
    my $self = shift;
    $self->{raise_error} = shift if @_;
    return $self->{raise_error};
}

# Get/set whether an error produces a warning in addition to returning an error
sub print_error {
    my $self = shift;
    $self->{print_error} = shift if @_;
    return $self->{print_error};
}

1;

my $nvx = Net::Nirvanix->new("");
$nvx->raise_error(1);
$nvx->{debug} = 5;
my @params = (["appkey", "YOURAPPKEY"], ["username", "YOURUSERNAME"], ["password", "YOURPASSWORD"]);

my $auth = Net::Nirvanix->new("authentication");

my $session_xml = $auth->Login(0, @params);
my $session_token;
if (defined $session_xml->{"SessionToken"}) {
    $session_token = $session_xml->{"SessionToken"};
}

@params = (["sessiontoken", $session_token], 
			["destFolderPath", "/"], 
			["fileoverwrite", "true"],
			["iprestricted", "false"],
			["excludednode", "node2"],
			["excludednode", "node4"],
			["sizebytes", -s "pltest.pdf"]);

my $imfs = Net::Nirvanix->new("imfs");
my $storage_node_xml = $imfs->GetStorageNodeExtended(0, @params);
my $upload_token;
my $upload_host;
print Dumper($storage_node_xml);

$upload_host = $storage_node_xml->{GetStorageNode}->{UploadHost};
$upload_token = $storage_node_xml->{GetStorageNode}->{UploadToken};
print $upload_host;
print $upload_token;
my $url = "http://" . $upload_host . "/uploadconcurrent.ashx?destFolderPath=/&uploadtoken=" . $upload_token;
print $url;

$nvx->upload(url => $url,
				threads => 2,
				localfile => "pltest.pdf");

$nvx->download(url => "http://node1.nirvanix.com/app/user/file.txt",
				threads => 10,
				localfile => "pltest.pdf");

print "Content-Length: " . $nvx->{head}{content_length};
print "\nMD5: " . $nvx->{head}{md5} . "\n";

__END__

=head1 METHODS

Most all these methods return true on success or C<undef> on failure.
If C<raise_error> is true, then an exception is raised on failure.

=head2 Constructor

=head3 C<new>

  $n = Net::Nirvanix->new;
    or
  $n = Net::Nirvanix->new(
     app_key  => $app_key,
     username => $username,
     password => $password,
     %args
  );

Constructor which returns a new "Net::Nirvanix" object.